Usenet 1993 July/InfoMagic USENET CD-ROM July 1993.ISO/sources/misc/volume11/ephem4.12/part02

Text File | 1990-03-10 | 58.8 KB | 2,405 lines

Newsgroups: comp.sources.misc
subject: v11i003: ephem, 2 of 7
From: [e-mail]@ncs-med.UUCP (Elwood C. Downey)
Sender: [e-mail] (Brandon S. Allbery - comp.sources.misc)

Posting-number: Volume 11, Issue 3
Submitted-by: [e-mail]@ncs-med.UUCP (Elwood C. Downey)
Archive-name: ephem4.12/part02

# This is the first line of a "shell archive" file.
# This means it contains several files that can be extracted into
# the current directory when run with the sh shell, as follows:
#    sh < this_file_name
# This is file 2.
echo x compiler.c
sed -e 's/^X//' << 'EOFxEOF' > compiler.c
X/* module to compile and execute a c-style arithmetic expression.
X * public entry points are compile_expr() and execute_expr().
X *
X * one reason this is so nice and tight is that all opcodes are the same size
X * (an int) and the tokens the parser returns are directly usable as opcodes,
X * for the most part. constants and variables are compiled as an opcode
X * with an offset into the auxiliary opcode tape, opx.
X */
X
X#include <math.h>
X#include "screen.h"
X
X/* parser tokens and opcodes, as necessary */
X#define    HALT    0    /* good value for HALT since program is inited to 0 */
X/* binary operators (precedences in table, below) */
X#define    ADD    1
X#define    SUB    2
X#define    MULT    3
X#define    DIV    4
X#define    AND    5
X#define    OR    6
X#define    GT    7
X#define    GE    8
X#define    EQ    9
X#define    NE    10
X#define    LT    11
X#define    LE    12
X/* unary op, precedence in NEG_PREC #define, below */
X#define    NEG    13
X/* symantically operands, ie, constants, variables and all functions */
X#define    CONST    14
X#define    VAR    15
X#define    ABS    16    /* add functions if desired just like this is done */
X/* purely tokens - never get compiled as such */
X#define    LPAREN    255
X#define    RPAREN    254
X#define    ERR    (-1)
X
X/* precedence of each of the binary operators.
X * in case of a tie, compiler associates left-to-right.
X * N.B. each entry's index must correspond to its #define!
X */
Xstatic int precedence[] = {0,5,5,6,6,2,1,4,4,3,3,4,4};
X#define    NEG_PREC    7    /* negation is highest */
X
X/* execute-time operand stack */
X#define    MAX_STACK    16
Xstatic double stack[MAX_STACK], *sp;
X
X/* space for compiled opcodes - the "program".
X * opcodes go in lower 8 bits.
X * when an opcode has an operand (as CONST and VAR) it is really in opx[] and
X *   the index is in the remaining upper bits.
X */
X#define    MAX_PROG 32
Xstatic int program[MAX_PROG], *pc;
X#define    OP_SHIFT    8
X#define    OP_MASK        0xff
X
X/* auxiliary operand info.
X * the operands (all but lower 8 bits) of CONST and VAR are really indeces
X * into this array. thus, no point in making this any longer than you have
X * bits more than 8 in your machine's int to index into it, ie, make
X *    MAX_OPX <= 1 << ((sizeof(int)-1)*8)
X * also, the fld's must refer to ones being flog'd, so not point in more
X * of these then that might be used for plotting and srching combined.
X */
X#define    MAX_OPX    16
Xtypedef union {
X    double opu_f;        /* value when opcode is CONST */
X    int opu_fld;        /* rcfpack() of field when opcode is VAR */
X} OpX;
Xstatic OpX opx[MAX_OPX];
Xstatic int opxidx;
X
X/* these are global just for easy/rapid access */
Xstatic int parens_nest;    /* to check that parens end up nested */
Xstatic char *err_msg;    /* caller provides storage; we point at it with this */
Xstatic char *cexpr, *lcexpr; /* pointers that move along caller's expression */
Xstatic int good_prog;    /* != 0 when program appears to be good */
X
X/* compile the given c-style expression.
X * return 0 and set good_prog if ok,
X * else return -1 and a reason message in errbuf.
X */
Xcompile_expr (ex, errbuf)
Xchar *ex;
Xchar *errbuf;
X{
X    int instr;
X
X    /* init the globals.
X     * also delete any flogs used in the previous program.
X     */
X    cexpr = ex;
X    err_msg = errbuf;
X    pc = program;
X    opxidx = 0;
X    parens_nest = 0;
X    do {
X        instr = *pc++;
X        if ((instr & OP_MASK) == VAR)
X        flog_delete (opx[instr >> OP_SHIFT].opu_fld);
X    } while (instr != HALT);
X
X    pc = program;
X    if (compile(0) == ERR) {
X        sprintf (err_msg + strlen(err_msg), " at \"%.10s\"", lcexpr);
X        good_prog = 0;
X        return (-1);
X    }
X    *pc++ = HALT;
X    good_prog = 1;
X    return (0);
X}
X
X/* execute the expression previously compiled with compile_expr().
X * return 0 with *vp set to the answer if ok, else return -1 with a reason
X * why not message in errbuf.
X */
Xexecute_expr (vp, errbuf)
Xdouble *vp;
Xchar *errbuf;
X{
X    int s;
X
X    err_msg = errbuf;
X    sp = stack + MAX_STACK;    /* grows towards lower addresses */
X    pc = program;
X    s = execute(vp);
X    if (s < 0)
X        good_prog = 0;
X    return (s);
X}
X
X/* this is a way for the outside world to ask whether there is currently a
X * reasonable program compiled and able to execute.
X */
Xprog_isgood()
X{
X    return (good_prog);
X}
X
X/* get and return the opcode corresponding to the next token.
X * leave with lcexpr pointing at the new token, cexpr just after it.
X * also watch for mismatches parens and proper operator/operand alternation.
X */
Xstatic
Xnext_token ()
X{
X    static char toomt[] = "More than %d terms";
X    static char badop[] = "Illegal operator";
X    int tok = ERR;    /* just something illegal */
X    char c;
X
X    while ((c = *cexpr) == ' ')
X        cexpr++;
X    lcexpr = cexpr++;
X
X    /* mainly check for a binary operator */
X    switch (c) {
X    case '\0': --cexpr; tok = HALT; break; /* keep returning HALT */
X    case '+': tok = ADD; break; /* compiler knows when it's really unary */
X    case '-': tok = SUB; break; /* compiler knows when it's really negate */
X    case '*': tok = MULT; break;
X    case '/': tok = DIV; break;
X    case '(': parens_nest++; tok = LPAREN; break;
X    case ')':
X        if (--parens_nest < 0) {
X            sprintf (err_msg, "Too many right parens");
X        return (ERR);
X        } else
X        tok = RPAREN;
X        break;
X    case '|':
X        if (*cexpr == '|') { cexpr++; tok = OR; }
X        else { sprintf (err_msg, badop); return (ERR); }
X        break;
X    case '&':
X        if (*cexpr == '&') { cexpr++; tok = AND; }
X        else { sprintf (err_msg, badop); return (ERR); }
X        break;
X    case '=':
X        if (*cexpr == '=') { cexpr++; tok = EQ; }
X        else { sprintf (err_msg, badop); return (ERR); }
X        break;
X    case '!':
X        if (*cexpr == '=') { cexpr++; tok = NE; }
X        else { sprintf (err_msg, badop); return (ERR); }
X        break;
X    case '<':
X        if (*cexpr == '=') { cexpr++; tok = LE; }
X        else tok = LT;
X        break;
X    case '>':
X        if (*cexpr == '=') { cexpr++; tok = GE; }
X        else tok = GT;
X        break;
X    }
X
X    if (tok != ERR)
X        return (tok);
X
X    /* not op so check for a constant, variable or function */
X    if (isdigit(c) || c == '.') {
X        if (opxidx > MAX_OPX) {
X        sprintf (err_msg, toomt, MAX_OPX);
X        return (ERR);
X        }
X        opx[opxidx].opu_f = atof (lcexpr);
X        tok = CONST | (opxidx++ << OP_SHIFT);
X        skip_double();
X    } else if (isalpha(c)) {
X        /* check list of functions */
X        if (strncmp (lcexpr, "abs", 3) == 0) {
X        cexpr += 2;
X        tok = ABS;
X        } else {
X        /* not a function, so assume it's a variable */
X        int fld;
X        if (opxidx > MAX_OPX) {
X            sprintf (err_msg, toomt, MAX_OPX);
X            return (ERR);
X        }
X        fld = parse_fieldname ();
X        if (fld < 0) {
X            sprintf (err_msg, "Unknown field");
X            return (ERR);
X        } else {
X            if (flog_add (fld) < 0) { /* register with field logger */
X            sprintf (err_msg, "Sorry; too many fields");
X            return (ERR);
X            }
X            opx[opxidx].opu_fld = fld;
X            tok = VAR | (opxidx++ << OP_SHIFT);
X        }
X        }
X    }
X
X    return (tok);
X}
X
X/* move cexpr on past a double.
X * allow sci notation.
X * no need to worry about a leading '-' or '+' but allow them after an 'e'.
X * TODO: this handles all the desired cases, but also admits a bit too much
X *   such as things like 1eee2...3. geeze; to skip a double right you almost
X *   have to go ahead and crack it!
X */
Xstatic
Xskip_double()
X{
X    int sawe = 0;    /* so we can allow '-' or '+' right after an 'e' */
X
X    while (1) {
X        char c = *cexpr;
X        if (isdigit(c) || c=='.' || (sawe && (c=='-' || c=='+'))) {
X        sawe = 0;
X        cexpr++;
X        } else if (c == 'e') {
X        sawe = 1;
X        cexpr++;
X        } else
X        break;
X    }
X}
X
X/* call this whenever you want to dig out the next (sub)expression.
X * keep compiling instructions as long as the operators are higher precedence
X * than prec, then return that "look-ahead" token that wasn't (higher prec).
X * if error, fill in a message in err_msg[] and return ERR.
X */
Xstatic
Xcompile (prec)
Xint prec;
X{
X    int expect_binop = 0;    /* set after we have seen any operand.
X                 * used by SUB so it can tell if it really
X                 * should be taken to be a NEG instead.
X                 */
X    int tok = next_token ();
X
X        while (1) {
X        int p;
X        if (tok == ERR)
X        return (ERR);
X        if (pc - program >= MAX_PROG) {
X        sprintf (err_msg, "Program is too long");
X        return (ERR);
X        }
X
X        /* check for special things like functions, constants and parens */
X            switch (tok & OP_MASK) {
X            case HALT: return (tok);
X        case ADD:
X        if (expect_binop)
X            break;    /* procede with binary addition */
X        /* just skip a unary positive(?) */
X        tok = next_token();
X        continue;
X        case SUB:
X        if (expect_binop)
X            break;    /* procede with binary subtract */
X        tok = compile (NEG_PREC);
X        *pc++ = NEG;
X        expect_binop = 1;
X        continue;
X            case ABS: /* other funcs would be handled the same too ... */
X        /* eat up the function parenthesized argument */
X        if (next_token() != LPAREN || compile (0) != RPAREN) {
X            sprintf (err_msg, "Function arglist error");
X            return (ERR);
X        }
X        /* then handled same as ... */
X            case CONST: /* handled same as... */
X        case VAR:
X        *pc++ = tok;
X        tok = next_token();
X        expect_binop = 1;
X        continue;
X            case LPAREN:
X        if (compile (0) != RPAREN) {
X            sprintf (err_msg, "Unmatched left paren");
X            return (ERR);
X        }
X        tok = next_token();
X        expect_binop = 1;
X        continue;
X            case RPAREN:
X        return (RPAREN);
X            }
X
X        /* everything else is a binary operator */
X        p = precedence[tok];
X            if (p > prec) {
X                int newtok = compile (p);
X        if (newtok == ERR)
X            return (ERR);
X                *pc++ = tok;
X        expect_binop = 1;
X                tok = newtok;
X            } else
X                return (tok);
X        }
X}
X
X/* "run" the program[] compiled with compile().
X * if ok, return 0 and the final result,
X * else return -1 with a reason why not message in err_msg.
X */
Xstatic
Xexecute(result)
Xdouble *result;
X{
X    int instr;
X
X    do {
X        instr = *pc++;
X        switch (instr & OP_MASK) {
X        /* put these in numberic order so hopefully even the dumbest
X         * compiler will choose to use a jump table, not a cascade of ifs.
X         */
X        case HALT: break;    /* outer loop will stop us */
X        case ADD:  sp[1] = sp[1] +  sp[0]; sp++; break;
X        case SUB:  sp[1] = sp[1] -  sp[0]; sp++; break;
X        case MULT: sp[1] = sp[1] *  sp[0]; sp++; break;
X        case DIV:  sp[1] = sp[1] /  sp[0]; sp++; break;
X        case AND:  sp[1] = sp[1] && sp[0] ? 1 : 0; sp++; break;
X        case OR:   sp[1] = sp[1] || sp[0] ? 1 : 0; sp++; break;
X        case GT:   sp[1] = sp[1] >  sp[0] ? 1 : 0; sp++; break;
X        case GE:   sp[1] = sp[1] >= sp[0] ? 1 : 0; sp++; break;
X        case EQ:   sp[1] = sp[1] == sp[0] ? 1 : 0; sp++; break;
X        case NE:   sp[1] = sp[1] != sp[0] ? 1 : 0; sp++; break;
X        case LT:   sp[1] = sp[1] <  sp[0] ? 1 : 0; sp++; break;
X        case LE:   sp[1] = sp[1] <= sp[0] ? 1 : 0; sp++; break;
X        case NEG:  *sp = -*sp; break;
X        case CONST: *--sp = opx[instr >> OP_SHIFT].opu_f; break;
X        case VAR:
X        if (flog_get (opx[instr >> OP_SHIFT].opu_fld, --sp) < 0) {
X            sprintf (err_msg, "Bug! VAR field not logged");
X            return (-1);
X        }
X        break;
X        case ABS:  *sp = fabs (*sp); break;
X        default:
X        sprintf (err_msg, "Bug! bad opcode: 0x%x", instr);
X        return (-1);
X        }
X        if (sp < stack) {
X        sprintf (err_msg, "Runtime stack overflow");
X        return (-1);
X        } else if (sp - stack > MAX_STACK) {
X        sprintf (err_msg, "Bug! runtime stack underflow");
X        return (-1);
X        }
X    } while (instr != HALT);
X
X    /* result should now be on top of stack */
X    if (sp != &stack[MAX_STACK - 1]) {
X        sprintf (err_msg, "Bug! stack has %d items",MAX_STACK-(sp-stack));
X        return (-1);
X    }
X    *result = *sp;
X    return (0);
X}
X
Xstatic
Xisdigit(c)
Xchar c;
X{
X    return (c >= '0' && c <= '9');
X}
X
Xstatic
Xisalpha (c)
Xchar c;
X{
X    return ((c >= 'a' && c <= 'z') || (c >=  'A' && c <= 'Z'));
X}
X
X/* starting with lcexpr pointing at a string expected to be a field name,
X * return an rcfpack(r,c,0) of the field else -1 if bad.
X * when return, leave lcexpr alone but move cexpr to just after the name.
X */
Xstatic
Xparse_fieldname ()
X{
X    int r = -1, c = -1;     /* anything illegal */
X    char *fn = lcexpr;    /* likely faster than using the global */
X    char f0, f1;
X    char *dp;
X
X    /* search for first thing not an alpha char.
X     * leave it in f0 and leave dp pointing to it.
X     */
X    dp = fn;
X    while (isalpha(f0 = *dp))
X        dp++;
X
X    /* crack the new field name.
X     * when done trying, leave dp pointing at first char just after it.
X     * set r and c if we recognized it.
X     */
X    if (f0 == '.') {
X        /* planet.column pair.
X         * first crack the planet portion (pointed to by fn): set r.
X         * then the second portion (pointed to by dp+1): set c.
X         */
X        f0 = fn[0];
X        f1 = fn[1];
X        switch (f0) {
X        case 'j':
X                    r = R_JUPITER;
X        break;
X        case 'm':
X        if (f1 == 'a')      r = R_MARS;
X        else if (f1 == 'e') r = R_MERCURY;
X        else if (f1 == 'o') r = R_MOON;
X        break;
X        case 'n':
X                    r = R_NEPTUNE;
X        break;
X        case 'p':
X                    r = R_PLUTO;
X        break;
X        case 's':
X        if (f1 == 'a')      r = R_SATURN;
X        else if (f1 == 'u') r = R_SUN;
X        break;
X        case 'u':
X                    r = R_URANUS;
X        break;
X        case 'x':
X                    r = R_OBJX;
X        break;
X        case 'v':
X                    r = R_VENUS;
X        break;
X        }
X
X        /* now crack the column (stuff after the dp) */
X        dp++;    /* point at good stuff just after the decimal pt */
X        f0 = dp[0];
X        f1 = dp[1];
X        switch (f0) {
X        case 'a':
X        if (f1 == 'l')        c = C_ALT;
X        else if (f1 == 'z')   c = C_AZ;
X        break;
X        case 'd':
X                      c = C_DEC;
X        break;
X        case 'e':
X        if (f1 == 'd')        c = C_EDIST;
X        else if (f1 == 'l')   c = C_ELONG;
X        break;
X        case 'h':
X        if (f1 == 'l') {
X            if (dp[2] == 'a')              c = C_HLAT;
X            else if (dp[2] == 'o')         c = C_HLONG;
X        } else if (f1 == 'r' || f1 == 'u') c = C_TUP;
X        break;
X        case 'j':
X                      c = C_JUPITER;
X        break;
X        case 'm':
X        if (f1 == 'a')        c = C_MARS;
X        else if (f1 == 'e')   c = C_MERCURY;
X        else if (f1 == 'o')   c = C_MOON;
X        break;
X        case 'n':
X                      c = C_NEPTUNE;
X        break;
X        case 'p':
X        if (f1 == 'h')        c = C_PHASE;
X        else if (f1 == 'l')   c = C_PLUTO;
X        break;
X        case 'r':
X        if (f1 == 'a') {
X            if (dp[2] == 'z') c = C_RISEAZ;
X            else           c = C_RA;
X        } else if (f1 == 't') c = C_RISETM;
X        break;
X        case 's':
X        if (f1 == 'a') {
X            if (dp[2] == 'z') c = C_SETAZ;
X            else          c = C_SATURN;
X        } else if (f1 == 'd') c = C_SDIST;
X        else if (f1 == 'i')   c = C_SIZE;
X        else if (f1 == 't')   c = C_SETTM;
X        else if (f1 == 'u')   c = C_SUN;
X        break;
X        case 't':
X        if (f1 == 'a')        c = C_TRANSALT;
X        else if (f1 == 't')   c = C_TRANSTM;
X        break;
X        case 'u':
X                      c = C_URANUS;
X        break;
X        case 'v':
X        if (f1 == 'e')        c = C_VENUS;
X        else if (f1 == 'm')   c = C_MAG;
X        break;
X        }
X
X        /* now skip dp on past the column stuff */
X        while (isalpha(*dp))
X        dp++;
X    } else {
X        /* no decimal point; some field in the top of the screen */
X        f0 = fn[0];
X        f1 = fn[1];
X        switch (f0) {
X        case 'd':
X        if (f1 == 'a')      r = R_DAWN, c = C_DAWNV;
X        else if (f1 == 'u') r = R_DUSK, c = C_DUSKV;
X        break;
X        case 'n':
X        r = R_LON, c = C_LONV;
X        break;
X        }
X    }
X
X    cexpr = dp;
X    if (r <= 0 || c <= 0) return (-1);
X    return (rcfpack (r, c, 0));
X}
EOFxEOF
len=`wc -c < compiler.c`
if expr $len != 15015 > /dev/null
then echo Length of compiler.c is $len but it should be 15015.
fi
echo x eq_ecl.c
sed -e 's/^X//' << 'EOFxEOF' > eq_ecl.c
X#include <stdio.h>
X#include <math.h>
X#include "astro.h"
X
X#define    EQtoECL    1
X#define    ECLtoEQ    (-1)
X
X/* given the modified Julian date, mjd, and an equitorial ra and dec, each in
X * radians, find the corresponding geocentric ecliptic latitude, *lat, and
X * longititude, *lng, also each in radians.
X * correction for the effect on the angle of the obliquity due to nutation is
X * included.
X */
Xeq_ecl (mjd, ra, dec, lat, lng)
Xdouble mjd, ra, dec;
Xdouble *lat, *lng;
X{
X    ecleq_aux (EQtoECL, mjd, ra, dec, lng, lat);
X}
X
X/* given the modified Julian date, mjd, and a geocentric ecliptic latitude,
X * *lat, and longititude, *lng, each in radians, find the corresponding
X * equitorial ra and dec, also each in radians.
X * correction for the effect on the angle of the obliquity due to nutation is
X * included.
X */
Xecl_eq (mjd, lat, lng, ra, dec)
Xdouble mjd, lat, lng;
Xdouble *ra, *dec;
X{
X    ecleq_aux (ECLtoEQ, mjd, lng, lat, ra, dec);
X}
X
Xstatic
Xecleq_aux (sw, mjd, x, y, p, q)
Xint sw;            /* +1 for eq to ecliptic, -1 for vv. */
Xdouble mjd, x, y;    /* sw==1: x==ra, y==dec.  sw==-1: x==lng, y==lat. */
Xdouble *p, *q;        /* sw==1: p==lng, q==lat. sw==-1: p==ra, q==dec. */
X{
X    static double lastmjd;        /* last mjd calculated */
X    static double seps, ceps;    /* sin and cos of mean obliquity */
X    double sx, cx, sy, cy, ty;
X
X    if (mjd != lastmjd) {
X        double eps;
X        double deps, dpsi;
X        obliquity (mjd, &eps);        /* mean obliquity for date */
X        nutation (mjd, &deps, &dpsi);
X        eps += deps;
X            seps = sin(eps);
X        ceps = cos(eps);
X        lastmjd = mjd;
X    }
X
X    sy = sin(y);
X    cy = cos(y);                /* always non-negative */
X        if (fabs(cy)<1e-20) cy = 1e-20;        /* insure > 0 */
X        ty = sy/cy;
X    cx = cos(x);
X    sx = sin(x);
X        *q = asin((sy*ceps)-(cy*seps*sx*sw));
X        *p = atan(((sx*ceps)+(ty*seps*sw))/cx);
X        if (cx<0) *p += PI;        /* account for atan quad ambiguity */
X    range (p, 2*PI);
X}
EOFxEOF
len=`wc -c < eq_ecl.c`
if expr $len != 1891 > /dev/null
then echo Length of eq_ecl.c is $len but it should be 1891.
fi
echo x flog.c
sed -e 's/^X//' << 'EOFxEOF' > flog.c
X/* this is a simple little package to manage the saving and retrieving of
X * field values, which we call field logging or "flogs". a flog consists of a
X * field location, ala rcfpack(), and its value as a double. you can reset the
X * list of flogs, add to and remove from the list of registered fields and log
X * a field if it has been registered.
X *
X * this is used by the plotting and searching facilities of ephem to maintain
X * the values of the fields that are being plotted or used in search
X * expressions.
X *
X * a field can be in use for more than one
X * thing at a time (eg, all the X plot values may the same time field, or
X * searching and plotting might be on at one time using the same field) so
X * we consider the field to be in use as long a usage count is > 0.
X */
X
X#include "screen.h"
X
X#define    NFLOGS    32
X
Xtypedef struct {
X    int fl_usagecnt;    /* number of "users" logging to this field */
X    int fl_fld;        /* an rcfpack(r,c,0) */
X    double fl_val;
X} FLog;
X
Xstatic FLog flog[NFLOGS];
X
X/* add fld to the list. if already there, just increment usage count.
X * return 0 if ok, else -1 if no more room.
X */
Xflog_add (fld)
Xint fld;
X{
X    FLog *flp, *unusedflp = 0;
X
X    /* scan for fld already in list, or find an unused one along the way */
X    for (flp = &flog[NFLOGS]; --flp >= flog; ) {
X        if (flp->fl_usagecnt > 0) {
X        if (flp->fl_fld == fld) {
X            flp->fl_usagecnt++;
X            return (0);
X        }
X        } else
X        unusedflp = flp;
X    }
X    if (unusedflp) {
X        unusedflp->fl_fld = fld;
X        unusedflp->fl_usagecnt = 1;
X        return (0);
X    }
X    return (-1);
X}
X
X/* decrement usage count for flog for fld. if goes to 0 take it out of list.
X * ok if not in list i guess...
X */
Xflog_delete (fld)
Xint fld;
X{
X    FLog *flp;
X
X    for (flp = &flog[NFLOGS]; --flp >= flog; )
X        if (flp->fl_fld == fld && flp->fl_usagecnt > 0) {
X        if (--flp->fl_usagecnt <= 0) {
X            flp->fl_usagecnt = 0;
X        }
X        break;
X        }
X}
X
X/* if plotting or searching is active then
X * if rcfpack(r,c,0) is in the fld list, set its value to val.
X * return 0 if ok, else -1 if not in list.
X */
Xflog_log (r, c, val)
Xint r, c;
Xdouble val;
X{
X    if (plot_ison() || srch_ison()) {
X        FLog *flp;
X        int fld = rcfpack (r, c, 0);
X        for (flp = &flog[NFLOGS]; --flp >= flog; )
X        if (flp->fl_fld == fld && flp->fl_usagecnt > 0) {
X            flp->fl_val = val;
X            return(0);
X        }
X        return (-1);
X    } else
X        return (0);
X}
X
X/* search for fld in list. if find it return its value.
X * return 0 if found it, else -1 if not in list.
X */
Xflog_get (fld, vp)
Xint fld;
Xdouble *vp;
X{
X    FLog *flp;
X
X    for (flp = &flog[NFLOGS]; --flp >= flog; )
X        if (flp->fl_fld == fld && flp->fl_usagecnt > 0) {
X        *vp = flp->fl_val;
X        return (0);
X        }
X    return (-1);
X}
EOFxEOF
len=`wc -c < flog.c`
if expr $len != 2680 > /dev/null
then echo Length of flog.c is $len but it should be 2680.
fi
echo x formats.c
sed -e 's/^X//' << 'EOFxEOF' > formats.c
X/* basic formating routines.
X * all the screen oriented printing should go through here.
X */
X
X#include <stdio.h>
X#include <math.h>
X#include "astro.h"
X#include "screen.h"
X
Xextern char *strcpy();
X
X/* suppress screen io if this is true, but always flog stuff.
X */
Xstatic int f_scrnoff;
Xf_on ()
X{
X    f_scrnoff = 0;
X}
Xf_off ()
X{
X    f_scrnoff = 1;
X}
X
X/* draw n blanks at the given cursor position.  */
Xf_blanks (r, c, n)
Xint r, c, n;
X{
X    if (f_scrnoff)
X        return;
X    c_pos (r, c);
X    while (--n >= 0)
X        putchar (' ');
X}
X
X/* print the given value, v, in "sexadecimal" format at [r,c]
X * ie, in the form A:m.P, where A is a digits wide, P is p digits.
X * if p == 0, then no decimal point either.
X */
Xf_sexad (r, c, a, p, mod, v)
Xint r, c;
Xint a, p;    /* left space, min precision */
Xint mod;    /* don't let whole portion get this big */
Xdouble v;
X{
X    char astr[32], str[32];
X    long dec;
X    double frac;
X    int visneg;
X
X    (void) flog_log (r, c, v);
X
X    if (f_scrnoff)
X        return;
X
X    if (v >= 0.0)
X        visneg = 0;
X    else {
X        if (v <= -0.5/60.0*pow(10.0,-1.0*p)) {
X        v = -v;
X        visneg = 1;
X        } else {
X        /* don't show as negative if less than the precision showing */
X        v = 0.0;
X        visneg = 0;
X        }
X    }
X
X    dec = v;
X    frac = (v - dec)*60.0;
X    sprintf (str, "59.%.*s5", p, "999999999");
X    if (frac >= atof (str)) {
X        dec += 1;
X        frac = 0.0;
X    }
X    dec %= mod;
X    if (dec == 0 && visneg)
X        strcpy (str, "-0");
X    else
X        sprintf (str, "%ld", visneg ? -dec : dec);
X
X    /* would just do this if Turbo-C 2.0 %?.0f" worked:
X     * sprintf (astr, "%*s:%0*.*f", a, str, p == 0 ? 2 : p+3, p, frac);
X     */
X    if (p == 0)
X        sprintf (astr, "%*s:%02d", a, str, (int)(frac+0.5));
X    else
X        sprintf (astr, "%*s:%0*.*f", a, str, p+3, p, frac);
X    f_string (r, c, astr);
X}
X
X/* print the given value, t, in sexagesimal format at [r,c]
X * ie, in the form T:mm:ss, where T is nd digits wide.
X * N.B. we assume nd >= 2.
X */
Xf_sexag (r, c, nd, t)
Xint r, c, nd;
Xdouble t;
X{
X    char tstr[32];
X    int h, m, s;
X    int tisneg;
X
X    (void) flog_log (r, c, t);
X    if (f_scrnoff)
X        return;
X    dec_sex (t, &h, &m, &s, &tisneg);
X    if (h == 0 && tisneg)
X        sprintf (tstr, "%*s-0:%02d:%02d", nd-2, "", m, s);
X    else
X        sprintf (tstr, "%*d:%02d:%02d", nd, tisneg ? -h : h, m, s);
X    f_string (r, c, tstr);
X}
X
X/* print angle ra, in radians, in ra hours as hh:mm.m at [r,c]
X * N.B. we assume ra is >= 0.
X */
Xf_ra (r, c, ra)
Xint r, c;
Xdouble ra;
X{
X    f_sexad (r, c, 2, 1, 24, radhr(ra));
X}
X
X/* print time, t, as hh:mm:ss */
Xf_time (r, c, t)
Xint r, c;
Xdouble t;
X{
X    f_sexag (r, c, 2, t);
X}
X
X/* print time, t, as +/-hh:mm:ss (don't show leading +) */
Xf_signtime (r, c, t)
Xint r, c;
Xdouble t;
X{
X    f_sexag (r, c, 3, t);
X}
X
X/* print time, t, as hh:mm */
Xf_mtime (r, c, t)
Xint r, c;
Xdouble t;
X{
X    f_sexad (r, c, 2, 0, 24, t);
X}
X
X/* print angle, a, in rads, as degress at [r,c] in form ddd:mm */
Xf_angle(r, c, a)
Xint r, c;
Xdouble a;
X{
X    f_sexad (r, c, 3, 0, 360, raddeg(a));
X}
X
X/* print angle, a, in rads, as degress at [r,c] in form dddd:mm:ss */
Xf_gangle(r, c, a)
Xint r, c;
Xdouble a;
X{
X    f_sexag (r, c, 4, raddeg(a));
X}
X
X/* print the given modified Julian date, jd, as the starting date at [r,c]
X * in the form mm/dd/yyyy.
X */
Xf_date (r, c, jd)
Xint r, c;
Xdouble jd;
X{
X    char dstr[32];
X    int m, y;
X    double d, tmp;
X
X    /* shadow to the plot subsystem as years. */
X    mjd_year (jd, &tmp);
X    (void) flog_log (r, c, tmp);
X    if (f_scrnoff)
X        return;
X
X    mjd_cal (jd, &m, &d, &y);
X
X    sprintf (dstr, "%2d/%02d/%04d", m, (int)(d), y);
X    f_string (r, c, dstr);
X}
X
Xf_char (row, col, c)
Xint row, col;
Xchar c;
X{
X    if (f_scrnoff)
X        return;
X    c_pos (row, col);
X    putchar (c);
X}
X
Xf_string (r, c, s)
Xint r, c;
Xchar *s;
X{
X    if (f_scrnoff)
X        return;
X    c_pos (r, c);
X    fputs (s, stdout);
X}
X
Xf_double (r, c, fmt, f)
Xint r, c;
Xchar *fmt;
Xdouble f;
X{
X    char str[80];
X    (void) flog_log (r, c, f);
X    sprintf (str, fmt, f);
X    f_string (r, c, str);
X}
X
X/* print prompt line */
Xf_prompt (p)
Xchar *p;
X{
X    c_pos (R_PROMPT, C_PROMPT);
X    c_eol ();
X    c_pos (R_PROMPT, C_PROMPT);
X    fputs (p, stdout);
X}
X
X/* clear from [r,c] to end of line, if we are drawing now. */
Xf_eol (r, c)
Xint r, c;
X{
X    if (!f_scrnoff) {
X        c_pos (r, c);
X        c_eol();
X    }
X}
X
X/* print a message and wait for op to hit any key */
Xf_msg (m)
Xchar *m;
X{
X    f_prompt (m);
X    (void) read_char();
X}
X
X/* crack a line of the form X?X?X into its components,
X *   where X is an integer and ? can be any character except '0-9' or '-',
X *   such as ':' or '/'.
X * only change those fields that are specified:
X *   eg:  ::10    only changes *s
X *        10    only changes *d
X *        10:0  changes *d and *m
X * if see '-' anywhere, first non-zero component will be made negative.
X */
Xf_sscansex (bp, d, m, s)
Xchar *bp;
Xint *d, *m, *s;
X{
X    char c;
X    int *p = d;
X    int *nonzp = 0;
X    int sawneg = 0;
X    int innum = 0;
X
X    while (c = *bp++)
X        if (c >= '0' && c <= '9') {
X        if (!innum) {
X            *p = 0;
X            innum = 1;
X        }
X        *p = *p*10 + (c - '0');
X        if (*p && !nonzp)
X            nonzp = p;
X        } else if (c == '-') {
X        sawneg = 1;
X        } else if (c != ' ') {
X        /* advance to next component */
X        p = (p == d) ? m : s;
X        innum = 0;
X        }
X
X    if (sawneg && nonzp)
X        *nonzp = -*nonzp;
X}
X
X/* crack a floating date string, bp, of the form m/d/y, where d may be a
X *   floating point number, into its components.
X * leave any component unspecified unchanged.
X * actually, the slashes may be anything but digits or a decimal point.
X * this is functionally the same as f_sscansex() exept we allow for
X *   the day portion to be real, and we don't handle negative numbers.
X *   maybe someday we could make a combined one and use it everywhere.
X */
Xf_sscandate (bp, m, d, y)
Xchar *bp;
Xint *m, *y;
Xdouble *d;
X{
X    char *bp0, c;
X
X    bp0 = bp;
X    while ((c = *bp++) && (c >= '0' && c <= '9'))
X        continue;
X    if (bp > bp0+1)
X        *m = atoi (bp0);
X    if (c == '\0')
X        return;
X    bp0 = bp;
X    while ((c = *bp++) && (c >= '0' && c <= '9' || c == '.'))
X        continue;
X    if (bp > bp0+1)
X        *d = atof (bp0);
X    if (c == '\0')
X        return;
X    bp0 = bp;
X    while (c = *bp++)
X        continue;
X    if (bp > bp0+1)
X        *y = atoi (bp0);
X}
X
X/* just like dec_sex() but makes the first non-zero element negative if
X * x is negative (instead of returning a sign flag).
X */
Xf_dec_sexsign (x, h, m, s)
Xdouble x;
Xint *h, *m, *s;
X{
X    int n;
X    dec_sex (x, h, m, s, &n);
X    if (n) {
X        if (*h)
X        *h = -*h;
X        else if (*m)
X        *m = -*m;
X        else
X        *s = -*s;
X    }
X}
X
X/* return 1 if bp looks like a decimal year; else 0.
X * any number greater than 12 is assumed to be a year, or any string
X * with exactly one decimal point, an optional minus sign, and nothing
X * else but digits.
X */
Xdecimal_year (bp)
Xchar *bp;
X{
X    char c;
X    int ndig = 0, ndp = 0, nneg = 0, nchar = 0;
X    int n = atoi(bp);
X
X    while (c = *bp++) {
X        nchar++;
X        if (c >= '0' && c <= '9')
X        ndig++;
X        else if (c == '.')
X        ndp++;
X        else if (c == '-')
X        nneg++;
X    }
X
X    return (n > 12 || (ndp == 1 && nneg <= 1 && nchar == ndig+ndp+nneg));
X}
EOFxEOF
len=`wc -c < formats.c`
if expr $len != 6850 > /dev/null
then echo Length of formats.c is $len but it should be 6850.
fi
echo x io.c
sed -e 's/^X//' << 'EOFxEOF' > io.c
X/* this file (in principle) contains all the device-dependent code for
X * handling screen movement and reading the keyboard. public routines are:
X *   c_pos(r,c), c_erase(), c_eol();
X *   chk_char(), read_char(), read_line (buf, max); and
X *   byetty().
X * N.B. we assume output may be performed by printf(), putchar() and
X *   fputs(stdout). since these are buffered we flush first in read_char().
X */
X
X/* explanation of various conditional #define options:
X * UNIX: uses termcap for screen management.
X *   USE_NDELAY: does non-blocking tty reads with fcntl(O_NDELAY); otherwise
X *     this is done with ioctl(..,FIONREAD..). Use which ever works on your
X *     system.
X * TURBO_C: compiles for Turbo C 2.0. I'm told it works for Lattice and
X *     Microsoft too.
X *   USE_ANSISYS: default PC cursor control uses direct BIOS calls (thanks to
X *     Mr. Doug McDonald). If your PC does not work with this, however, add
X *     "device ANSI.SYS" to your config.sys file and build ephem with
X *     USE_ANSISYS.
X */
X
X#define    UNIX
X/* #define USE_NDELAY */
X/* #define TURBO_C */
X/* #define USE_ANSISYS */
X
X#include <stdio.h>
X#include "screen.h"
X
X#ifdef UNIX
X#include <sgtty.h>
X#include <signal.h>
X#ifdef USE_NDELAY
X#include <fcntl.h>
X#endif
X
Xextern char *tgoto();
Xstatic char *cm, *ce, *cl, *kl, *kr, *ku, *kd; /* curses sequences */
Xstatic int tloaded;
Xstatic int ttysetup;
Xstatic struct sgttyb orig_sgtty;
X
X/* move cursor to row, col, 1-based.
X * we assume this also moves a visible cursor to this location.
X */
Xc_pos (r, c)
Xint r, c;
X{
X    if (!tloaded) tload();
X    fputs (tgoto (cm, c-1, r-1), stdout);
X}
X
X/* erase entire screen. */
Xc_erase()
X{
X    if (!tloaded) tload();
X    fputs (cl, stdout);
X}
X
X/* erase to end of line */
Xc_eol()
X{
X    if (!tloaded) tload();
X    fputs (ce, stdout);
X}
X
X#ifdef USE_NDELAY
Xstatic char sav_char;    /* one character read-ahead for chk_char() */
X#endif
X
X/* return 0 if there is a char that may be read without blocking, else -1 */
Xchk_char()
X{
X#ifdef USE_NDELAY
X    if (!ttysetup) setuptty();
X    if (sav_char)
X        return (0);
X    fcntl (0, F_SETFL, O_NDELAY);    /* non-blocking read. FNDELAY on BSD */
X    if (read (0, &sav_char, 1) != 1)
X        sav_char = 0;
X    return (sav_char ? 0 : -1);
X#else
X    long n;
X    if (!ttysetup) setuptty();
X    ioctl (0, FIONREAD, &n);
X    return (n > 0 ? 0 : -1);
X#endif
X}
X
X/* read the next char, blocking if necessary, and return it. don't echo.
X * map the arrow keys if we can too into hjkl
X */
Xread_char()
X{
X    char c;
X    if (!ttysetup) setuptty();
X    fflush (stdout);
X#ifdef USE_NDELAY
X    fcntl (0, F_SETFL, 0);    /* blocking read */
X    if (sav_char) {
X        c = sav_char;
X        sav_char = 0;
X    } else
X#endif
X        read (0, &c, 1);
X    c = chk_arrow (c & 0177); /* just ASCII, please */
X    return (c);
X}
X
X/* used to time out of a read */
Xstatic got_alrm;
Xstatic
Xon_alrm()
X{
X    got_alrm = 1;
X}
X
X/* see if c is the first of any of the curses arrow key sequences.
X * if it is, read the rest of the sequence, and return the hjkl code
X * that corresponds.
X * if no match, just return c.
X */
Xstatic
Xchk_arrow (c)
Xregister char c;
X{
X    register char *seq;
X
X    if (c == *(seq = kl) || c == *(seq = kd) || c == *(seq = ku)
X                         || c == *(seq = kr)) {
X        char seqa[32]; /* maximum arrow escape sequence ever expected */
X        unsigned l = strlen(seq);
X        seqa[0] = c;
X        if (l > 1) {
X        extern unsigned alarm();
X        /* cautiously read rest of arrow sequence */
X        got_alrm = 0;
X        signal (SIGALRM, on_alrm);
X        alarm(2);
X        read (0, seqa+1, l-1);
X        alarm(0);
X        if (got_alrm)
X            return (c);
X        }
X        seqa[l] = '\0';
X        if (strcmp (seqa, kl) == 0)
X        return ('h');
X        if (strcmp (seqa, kd) == 0)
X        return ('j');
X        if (strcmp (seqa, ku) == 0)
X        return ('k');
X        if (strcmp (seqa, kr) == 0)
X        return ('l');
X    }
X    return (c);
X}
X
X/* do whatever might be necessary to get the screen and/or tty back into shape.
X */
Xbyetty()
X{
X    ioctl (0, TIOCSETP, &orig_sgtty);
X#ifdef USE_NDELAY
X    fcntl (0, F_SETFL, 0);    /* be sure to go back to blocking read */
X#endif
X}
X
Xstatic
Xtload()
X{
X    extern char *getenv(), *tgetstr();
X    extern char *UP, *BC;
X    char *egetstr();
X    static char tbuf[512];
X    char rawtbuf[1024];
X    char *tp;
X    char *ptr;
X
X    if (!(tp = getenv ("TERM"))) {
X        printf ("Must have addressable cursor\n");
X        exit(1);
X    }
X
X    if (!ttysetup) setuptty();
X    if (tgetent (rawtbuf, tp) != 1) {
X        printf ("Can't find termcap for %s\n", tp);
X        exit (1);
X    }
X    ptr = tbuf;
X    ku = egetstr ("ku", &ptr);
X    kd = egetstr ("kd", &ptr);
X    kl = egetstr ("kl", &ptr);
X    kr = egetstr ("kr", &ptr);
X    cm = egetstr ("cm", &ptr);
X    ce = egetstr ("ce", &ptr);
X    cl = egetstr ("cl", &ptr);
X    UP = egetstr ("up", &ptr);
X    if (!tgetflag ("bs"))
X        BC = egetstr ("bc", &ptr);
X    tloaded = 1;
X}
X
X/* like tgetstr() but discard curses delay codes, for now anyways */
Xstatic char *
Xegetstr (name, sptr)
Xchar *name;
Xchar **sptr;
X{
X    extern char *tgetstr();
X    register char c, *s;
X
X    s = tgetstr (name, sptr);
X    while (((c = *s) >= '0' && c <= '9') || c == '*')
X        s += 1;
X    return (s);
X}
X
X/* set up tty for char-by-char read, non-blocking  */
Xstatic
Xsetuptty()
X{
X    struct sgttyb sg;
X
X    ioctl (0, TIOCGETP, &orig_sgtty);
X    sg = orig_sgtty;
X    sg.sg_flags &= ~ECHO;    /* do our own echoing */
X    sg.sg_flags &= ~CRMOD;    /* leave CR and LF unchanged */
X    sg.sg_flags |= XTABS;    /* no tabs with termcap */
X    sg.sg_flags |= CBREAK;    /* wake up on each char but can still kill */
X    ioctl (0, TIOCSETP, &sg);
X    ttysetup = 1;
X}
X#endif
X
X#ifdef TURBO_C
X#ifdef USE_ANSISYS
X#define    ESC    '\033'
X/* position cursor.
X * (ANSI: ESC [ r ; c f) (r/c are numbers given in ASCII digits)
X */
Xc_pos (r, c)
Xint r, c;
X{
X    printf ("%c[%d;%df", ESC, r, c);
X}
X
X/* erase entire screen. (ANSI: ESC [ 2 J) */
Xc_erase()
X{
X    printf ("%c[2J", ESC);
X}
X
X/* erase to end of line. (ANSI: ESC [ K) */
Xc_eol()
X{
X    printf ("%c[K", ESC);
X}
X#else
X#include <dos.h>
Xunion REGS rg;
X
X/* position cursor.
X */
Xc_pos (r, c)
Xint r, c;
X{
X        rg.h.ah = 2;
X        rg.h.bh = 0;
X        rg.h.dh = r-1;
X        rg.h.dl = c-1;
X        int86(16,&rg,&rg);
X}
X
X/* erase entire screen.  */
Xc_erase()
X{
X        int cur_cursor, i;
X        rg.h.ah = 3;
X        rg.h.bh = 0;
X        int86(16,&rg,&rg);
X        cur_cursor = rg.x.dx;
X        for(i = 0; i < 25; i++){
X            c_pos(i+1,1);
X            rg.h.ah = 10;
X            rg.h.bh = 0;
X            rg.h.al = 32;
X            rg.x.cx = 80;
X            int86(16,&rg,&rg);
X        }
X        rg.h.ah = 2;
X        rg.h.bh = 0;
X        rg.x.dx = cur_cursor;
X        int86(16,&rg,&rg);
X
X}
X
X/* erase to end of line.*/
Xc_eol()
X{
X        int cur_cursor, i;
X        rg.h.ah = 3;
X        rg.h.bh = 0;
X        int86(16,&rg,&rg);
X        cur_cursor = rg.x.dx;
X        rg.h.ah = 10;
X        rg.h.bh = 0;
X        rg.h.al = 32;
X        rg.x.cx = 80 - rg.h.dl;
X        int86(16,&rg,&rg);
X        rg.h.ah = 2;
X        rg.h.bh = 0;
X        rg.x.dx = cur_cursor;
X        int86(16,&rg,&rg);
X
X}
X#endif
X
X/* return 0 if there is a char that may be read without blocking, else -1 */
Xchk_char()
X{
X    return (kbhit() == 0 ? -1 : 0);
X}
X
X/* read the next char, blocking if necessary, and return it. don't echo.
X * map the arrow keys if we can too into hjkl
X */
Xread_char()
X{
X    int c;
X    fflush (stdout);
X    c = getch();
X    if (c == 0) {
X        /* get scan code; convert to direction hjkl if possible */
X        c = getch();
X        switch (c) {
X        case 0x4b: c = 'h'; break;
X        case 0x50: c = 'j'; break;
X        case 0x48: c = 'k'; break;
X        case 0x4d: c = 'l'; break;
X        }
X    }
X    return (c);
X}
X
X/* do whatever might be necessary to get the screen and/or tty back into shape.
X */
Xbyetty()
X{
X}
X#endif
X
X/* read up to max chars into buf, with cannonization.
X * add trailing '\0' (buf is really max+1 chars long).
X * return count of chars read (not counting '\0').
X * assume cursor is already positioned as desired.
X * if type END when n==0 then return -1.
X */
Xread_line (buf, max)
Xchar buf[];
Xint max;
X{
X    static char erase[] = "\b \b";
X    int n, c;
X    int done;
X
X#ifdef UNIX
X    if (!ttysetup) setuptty();
X#endif
X
X    for (done = 0, n = 0; !done; )
X        switch (c = read_char()) {    /* does not echo */
X        case cntrl('h'):    /* backspace or */
X        case 0177:        /* delete are each char erase */
X        if (n > 0) {
X            fputs (erase, stdout);
X            n -= 1;
X        }
X        break;
X        case cntrl('u'):        /* line erase */
X        while (n > 0) {
X            fputs (erase, stdout);
X            n -= 1;
X        }
X        break;
X        case '\r':    /* EOL */
X        done++;
X        break;
X        default:            /* echo and store, if ok */
X        if (n == 0 && c == END)
X            return (-1);
X        if (n >= max)
X            putchar (cntrl('g'));
X        else if (c >= ' ') {
X            putchar (c);
X            buf[n++] = c;
X        }
X        }
X
X    buf[n] = '\0';
X    return (n);
X}
EOFxEOF
len=`wc -c < io.c`
if expr $len != 8533 > /dev/null
then echo Length of io.c is $len but it should be 8533.
fi
echo x main.c
sed -e 's/^X//' << 'EOFxEOF' > main.c
X/* main "ephem" program.
X * -------------------------------------------------------------------
X * Copyright (c) 1990 by Elwood Charles Downey
X *
X * Permission is granted to make and distribute copies of this program
X * free of charge, provided the copyright notice and this permission
X * notice are preserved on all copies.  All other rights reserved.
X * -------------------------------------------------------------------
X * set options.
X * init screen and circumstances.
X * enter infinite loop updating screen and allowing operator input.
X */
X
X#include <stdio.h>
X#include <signal.h>
X#include <math.h>
X#include "astro.h"
X#include "circum.h"
X#include "screen.h"
X
Xextern char *getenv();
Xextern char *strcpy();
X
X/* shorthands for fields of a Now structure, now.
X * first undo the ones for a Now pointer from circum.h.
X */
X#undef mjd
X#undef lat
X#undef lng
X#undef tz
X#undef temp
X#undef pressure
X#undef height
X#undef epoch
X#undef tznm
X
X#define mjd    now.n_mjd
X#define lat    now.n_lat
X#define lng    now.n_lng
X#define tz    now.n_tz
X#define temp    now.n_temp
X#define pressure now.n_pressure
X#define height    now.n_height
X#define epoch    now.n_epoch
X#define tznm    now.n_tznm
X
Xstatic char *cfgfile = "ephem.cfg";    /* default config filename */
X
Xstatic Now now;        /* where when and how, right now */
Xstatic double tminc;    /* hrs to inc time by each loop; RTC means use clock */
Xstatic int nstep;    /* steps to go before stopping */
Xstatic int optwi;    /* set when want to display dawn/dusk/len-of-night */
Xstatic int oppl;    /* mask of (1<<planet) bits; set when want to show it */
X
Xmain (ac, av)
Xint ac;
Xchar *av[];
X{
X    void bye();
X    static char freerun[] =
X        "Running... press any key to stop to make changes.";
X    static char prmpt[] =
X"Move to another field, RETURN to change this field, ? for help, or q to run";
X    static char hlp[] =
X    "arrow keys move to field; any key stops running; ^d exits; ^l redraws";
X    int curr = R_NSTEP, curc = C_NSTEPV;    /* must start somewhere */
X    int sflag = 0;    /* not silent, by default */
X    int one = 1;    /* use a variable so optimizer doesn't get disabled */
X    int srchdone = 0; /* true when search funcs say so */
X    int newcir = 2;    /* set when circumstances change - means don't tminc */
X
X    while ((--ac > 0) && (**++av == '-')) {
X        char *s;
X        for (s = *av+1; *s != '\0'; s++)
X        switch (*s) {
X        case 's': /* no credits "silent" (don't publish this) */
X            sflag++;
X            break;
X        case 'c': /* set name of config file to use */
X            if (--ac <= 0) usage("-c but no config file");
X            cfgfile = *++av;
X            break;
X        default:
X            usage("Bad - option");
X        }
X    }
X
X    if (!sflag)
X        credits();
X
X    /* fresh screen.
X     * crack config file, THEN args so args may override.
X     */
X    c_erase();
X    read_cfgfile (cfgfile);
X    read_fieldargs (ac, av);
X
X    /* set up to clean up screen and tty if interrupted */
X    signal (SIGINT, bye);
X
X    /* update screen forever (until QUIT) */
X    while (one) {
X
X        nstep -= 1;
X
X        /* recalculate everything and update all the fields */
X        redraw_screen (newcir);
X        mm_newcir (0);
X
X        /* let searching functions change tminc and check for done */
X        srchdone = srch_eval (mjd, &tminc) < 0;
X        print_tminc(0);    /* to show possibly new search increment */
X
X        /* update plot file, now that all fields are up to date and
X         * search function has been evaluated.
X         */
X        plot();
X
X        /* stop loop to allow op to change parameters:
X         * if a search evaluation converges (or errors out),
X         * or if steps are done,
X         * or if op hits any key.
X         */
X        newcir = 0;
X        if (srchdone || nstep <= 0 || (chk_char()==0 && read_char()!=0)) {
X        int fld;
X
X        /* update screen with the current stuff if stopped during
X         * unattended plotting since last redraw_screen() didn't.
X         */
X        if (plot_ison() && nstep > 0)
X            redraw_screen (1);
X
X        /* return nstep to default of 1 */
X        if (nstep <= 0) {
X            nstep = 1;
X            print_nstep (0);
X        }
X
X        /* change fields until END.
X         * update all time fields if any are changed
X         * and print NEW CIRCUMSTANCES if any have changed.
X         * QUIT causes bye() to be called and we never return.
X         */
X        while(fld = sel_fld(curr,curc,alt_menumask()|F_CHG,prmpt,hlp)) {
X            if (chg_fld ((char *)0, fld)) {
X            mm_now (&now, 1);
X            mm_newcir(1);
X            newcir = 1;
X            }
X            curr = unpackr (fld);
X            curc = unpackc (fld);
X        }
X        if (nstep > 1)
X            f_prompt (freerun);
X        }
X
X        /* increment time only if op didn't change cirumstances */
X        if (!newcir)
X        inc_mjd (&now, tminc);
X    }
X
X    return (0);
X}
X
X/* draw all the stuff on the screen, using the current menu.
X * if how_much == 0 then just update fields that need it;
X * if how_much == 1 then redraw all fields;
X * if how_much == 2 then erase the screen and redraw EVERYTHING.
X */
Xredraw_screen (how_much)
Xint how_much;
X{
X    if (how_much == 2)
X        c_erase();
X
X    /* print the single-step message if this is the last loop */
X    if (nstep < 1)
X        print_updating();
X
X    if (how_much == 2) {
X        mm_borders();
X        mm_labels();
X        srch_prstate(1);
X        plot_prstate(1);
X        alt_labels();
X    }
X
X    /* if just updating changed fields while plotting unattended then
X     * suppress most screen updates except
X     * always show nstep to show plot loops to go and
X     * always show tminc to show search convergence progress.
X     */
X    print_nstep(how_much);
X    print_tminc(how_much);
X    if (how_much == 0 && plot_ison() && nstep > 0)
X        f_off();
X
X    /* print all the time-related fields */
X    mm_now (&now, how_much);
X
X    if (optwi)
X        mm_twilight (&now, how_much);
X
X    /* print solar system body info */
X    print_bodies (how_much);
X
X    f_on();
X}
X
X/* clean up and exit for sure.
X */
Xvoid
Xbye()
X{
X    c_erase();
X    byetty();
X    exit (0);
X}
X
Xstatic
Xusage(why)
Xchar *why;
X{
X    /* don't advertise -s (silent) option */
X    c_erase();
X    f_string (1, 1, why);
X    f_string (2, 1, "usage: [-c <configfile>] [field=value] ...\r\n");
X    byetty();
X    exit (1);
X}
X
X/* read cfg file, fn, if present.
X * if errors in file, call usage() (which exits).
X * try $HOME/.ephemrc as last resort.
X * skip blank lines and lines that begin with '#', '*', ' ' or '\t'.
X */
Xstatic
Xread_cfgfile(fn)
Xchar *fn;
X{
X    char buf[128];
X    FILE *fp;
X
X    fp = fopen (fn, "r");
X    if (!fp) {
X        char *home = getenv ("HOME");
X        if (home) {
X        sprintf (buf, "%s/.ephemrc", home);
X        fp = fopen (buf, "r");
X        if (!fp)
X            return;    /* oh well */
X        fn = buf;    /* save fn for error report */
X        }
X    }
X
X    while (fgets (buf, sizeof(buf), fp)) {
X        switch (buf[0]) {
X        case '#': case '*': case ' ': case '\t': case '\n':
X        continue;
X        }
X        buf[strlen(buf)-1] = '\0';        /* discard trailing \n */
X        if (crack_fieldset (buf) < 0) {
X        char why[128];
X        sprintf (why, "Unknown field spec in %s: %s\n", fn, buf);
X        usage (why);
X        }
X    }
X    fclose (fp);
X}
X
X/* process the field specs from the command line.
X * if trouble call usage() (which exits).
X */
Xstatic
Xread_fieldargs (ac, av)
Xint ac;        /* number of such specs */
Xchar *av[];    /* array of strings in form <field_name value> */
X{
X    while (--ac >= 0) {
X        char *fs = *av++;
X        if (crack_fieldset (fs) < 0) {
X        char why[128];
X        sprintf (why, "Unknown command line field spec: %s", fs);
X        usage (why);
X        }
X    }
X}
X
X/* process a field spec in buf, either from config file or argv.
X * return 0 if recognized ok, else -1.
X */
Xstatic
Xcrack_fieldset (buf)
Xchar *buf;
X{
X    if (strncmp ("LAT", buf, 3) == 0)
X        (void) chg_fld (buf+4, rcfpack (R_LAT,C_LATV,0));
X    else if (strncmp ("LONG", buf, 4) == 0)
X        (void) chg_fld (buf+5, rcfpack (R_LONG,C_LONGV,0));
X    else if (strncmp ("UT", buf, 2) == 0)
X        (void) chg_fld (buf+3, rcfpack (R_UT,C_UTV,0));
X    else if (strncmp ("UD", buf, 2) == 0)
X        (void) chg_fld (buf+3, rcfpack (R_UD,C_UD,0));
X    else if (strncmp ("TZONE", buf, 5) == 0)
X        (void) chg_fld (buf+6, rcfpack (R_TZONE,C_TZONEV,0));
X    else if (strncmp ("TZNAME", buf, 6) == 0)
X        (void) chg_fld (buf+7, rcfpack (R_TZN,C_TZN,0));
X    else if (strncmp ("HEIGHT", buf, 6) == 0)
X        (void) chg_fld (buf+7, rcfpack (R_HEIGHT,C_HEIGHTV,0));
X    else if (strncmp ("NSTEP", buf, 5) == 0)
X        (void) chg_fld (buf+6, rcfpack (R_NSTEP,C_NSTEPV,0));
X    else if (strncmp ("STPSZ", buf, 5) == 0)
X        (void) chg_fld (buf+6, rcfpack (R_STPSZ,C_STPSZV,0));
X    else if (strncmp ("TEMP", buf, 4) == 0)
X        (void) chg_fld (buf+5, rcfpack (R_TEMP,C_TEMPV,0));
X    else if (strncmp ("PRES", buf, 4) == 0)
X        (void) chg_fld (buf+5, rcfpack (R_PRES,C_PRESV,0));
X    else if (strncmp ("EPOCH", buf, 5) == 0)
X        (void) chg_fld (buf+6, rcfpack (R_EPOCH,C_EPOCHV,0));
X    else if (strncmp ("JD", buf, 2) == 0)
X        (void) chg_fld (buf+3, rcfpack (R_JD,C_JDV,0));
X    else if (strncmp ("OBJX", buf, 4) == 0)
X        (void) objx_define (buf+5);
X    else if (strncmp ("PROPTS", buf, 6) == 0) {
X        char *bp = buf+7;
X        if (buf[6] != '+')
X        optwi = oppl = 0;
X        while (*bp)
X        switch (*bp++) {
X        case 'T': optwi = 1; break;
X        case 'S': oppl |= (1<<SUN); break;
X        case 'M': oppl |= (1<<MOON); break;
X        case 'e': oppl |= (1<<MERCURY); break;
X        case 'v': oppl |= (1<<VENUS); break;
X        case 'm': oppl |= (1<<MARS); break;
X        case 'j': oppl |= (1<<JUPITER); break;
X        case 's': oppl |= (1<<SATURN); break;
X        case 'u': oppl |= (1<<URANUS); break;
X        case 'n': oppl |= (1<<NEPTUNE); break;
X        case 'p': oppl |= (1<<PLUTO); break;
X        case 'x': oppl |= (1<<OBJX); objx_on(); break;
X        }
X    } else
X        return (-1);
X    return (0);
X}
X
X/* change the field at rcpk according to the optional string input at bp.
X * if bp is != 0 use it, else issue read_line() and use buffer.
X * then sscanf the buffer and update the corresponding (global) variable(s)
X * or do whatever a pick at that field should do.
X * return 1 if we change a field that invalidates any of the times or
X * to update all related fields.
X */
Xstatic
Xchg_fld (bp, rcpk)
Xchar *bp;
Xint rcpk;
X{
X    char buf[NC];
X    int deghrs = 0, mins = 0, secs = 0;
X    int new = 0;
X
X    /* switch on just the row/col portion */
X    switch (unpackrc(rcpk)) {
X    case rcfpack (R_ALTM, C_ALTM, 0):
X        if (altmenu_setup() == 0) {
X        print_updating();
X        alt_nolabels();
X        clrall_bodies();
X        alt_labels();
X        print_bodies(1);
X        }
X        break;
X    case rcfpack (R_JD, C_JDV, 0):
X        if (!bp) {
X        static char p[] = "Julian Date (or n for Now): ";
X        f_prompt (p);
X        if (read_line (buf, PW-sizeof(p)) <= 0)
X            break;
X        bp = buf;
X        }
X        if (bp[0] == 'n' || bp[0] == 'N')
X        time_fromsys (&now);
X        else
X        mjd = atof(bp) - 2415020L;
X        set_t0 (&now);
X        new = 1;
X        break;
X    case rcfpack (R_UD, C_UD, 0):
X        if (!bp) {
X        static char p[] = "utc date (m/d/y, or year.d, or n for Now): ";
X        f_prompt (p);
X        if (read_line (buf, PW-sizeof(p)) <= 0)
X            break;
X        bp = buf;
X        }
X        if (bp[0] == 'n' || bp[0] == 'N')
X        time_fromsys (&now);
X        else {
X        if (decimal_year(bp)) {
X            double y = atof (bp);
X            year_mjd (y, &mjd);
X        } else {
X            double day, newmjd0;
X            int month, year;
X            mjd_cal (mjd, &month, &day, &year); /* init with now */
X            f_sscandate (bp, &month, &day, &year);
X            cal_mjd (month, day, year, &newmjd0);
X            /* if don't give a fractional part to days
X             * then retain current hours.
X             */
X            if ((long)day == day)
X            mjd = newmjd0 + mjd_hr(mjd)/24.0;
X            else
X            mjd = newmjd0;
X        }
X        }
X        set_t0 (&now);
X        new = 1;
X        break;
X    case rcfpack (R_UT, C_UTV, 0):
X        if (!bp) {
X        static char p[] = "utc time (h:m:s, or n for Now): ";
X        f_prompt (p);
X        if (read_line (buf, PW-sizeof(p)) <= 0)
X            break;
X        bp = buf;
X        }
X        if (bp[0] == 'n' || bp[0] == 'N')
X        time_fromsys (&now);
X        else {
X        double newutc = (mjd-mjd_day(mjd)) * 24.0;
X        f_dec_sexsign (newutc, °hrs, &mins, &secs);
X        f_sscansex (bp, °hrs, &mins, &secs);
X        sex_dec (deghrs, mins, secs, &newutc);
X        mjd = mjd_day(mjd) + newutc/24.0;
X        }
X        set_t0 (&now);
X        new = 1;
X        break;
X    case rcfpack (R_LD, C_LD, 0):
X        if (!bp) {
X        static char p[] = "local date (m/d/y, or year.d, n for Now): ";
X        f_prompt (p);
X        if (read_line (buf, PW-sizeof(p)) <= 0)
X            break;
X        bp = buf;
X        }
X        if (bp[0] == 'n' || bp[0] == 'N')
X        time_fromsys (&now);
X        else {
X        if (decimal_year(bp)) {
X            double y = atof (bp);
X            year_mjd (y, &mjd);
X            mjd += tz/24.0;
X        } else {
X            double day, newlmjd0;
X            int month, year;
X            mjd_cal (mjd-tz/24.0, &month, &day, &year); /* now */
X            f_sscandate (bp, &month, &day, &year);
X            cal_mjd (month, day, year, &newlmjd0);
X            /* if don't give a fractional part to days
X             * then retain current hours.
X             */
X            if ((long)day == day)
X            mjd = newlmjd0 + mjd_hr(mjd-tz/24.0)/24.0;
X            else
X            mjd = newlmjd0;
X            mjd += tz/24.0;
X        }
X        }
X        set_t0 (&now);
X        new = 1;
X        break;
X    case rcfpack (R_LT, C_LT, 0):
X        if (!bp) {
X        static char p[] = "local time (h:m:s, or n for Now): ";
X        f_prompt (p);
X        if (read_line (buf, PW-sizeof(p)) <= 0)
X            break;
X        bp = buf;
X        }
X        if (bp[0] == 'n' || bp[0] == 'N')
X        time_fromsys (&now);
X        else {
X        double newlt = (mjd-mjd_day(mjd)) * 24.0 - tz;
X        range (&newlt, 24.0);
X        f_dec_sexsign (newlt, °hrs, &mins, &secs);
X        f_sscansex (bp, °hrs, &mins, &secs);
X        sex_dec (deghrs, mins, secs, &newlt);
X        mjd = mjd_day(mjd-tz/24.0) + (newlt + tz)/24.0;
X        }
X        set_t0 (&now);
X        new = 1;
X        break;
X    case rcfpack (R_LST, C_LSTV, 0):
X        if (!bp) {
X        static char p[] = "local sidereal time (h:m:s, or n for Now): ";
X        f_prompt (p);
X        if (read_line (buf, PW-sizeof(p)) <= 0)
X            break;
X        bp = buf;
X        }
X        if (bp[0] == 'n' || bp[0] == 'N')
X        time_fromsys (&now);
X        else {
X        double lst, utc;
X        now_lst (&now, &lst);
X        f_dec_sexsign (lst, °hrs, &mins, &secs);
X        f_sscansex (bp, °hrs, &mins, &secs);
X        sex_dec (deghrs, mins, secs, &lst);
X        lst -= radhr(lng); /* convert to gst */
X        range (&lst, 24.0);
X        gst_utc (mjd_day(mjd), lst, &utc);
X        mjd = mjd_day(mjd) + utc/24.0;
X        }
X        set_t0 (&now);
X        new = 1;
X        break;
X    case rcfpack (R_TZN, C_TZN, 0):
X        if (!bp) {
X        static char p[] = "timezone abbreviation (3 char max): ";
X        f_prompt (p);
X        if (read_line (buf, 3) <= 0)
X            break;
X        bp = buf;
X        }
X        strcpy (tznm, bp);
X        new = 1;
X        break;
X    case rcfpack (R_TZONE, C_TZONEV, 0):
X        if (!bp) {
X        static char p[] = "hours behind utc: ";
X        f_prompt (p);
X        if (read_line (buf, PW-sizeof(p)) <= 0)
X            break;
X        bp = buf;
X        }
X        f_dec_sexsign (tz, °hrs, &mins, &secs);
X        f_sscansex (bp, °hrs, &mins, &secs);
X        sex_dec (deghrs, mins, secs, &tz);
X        new = 1;
X        break;
X    case rcfpack (R_LONG, C_LONGV, 0):
X        if (!bp) {
X        static char p[] = "longitude (+ west) (d:m:s): ";
X        f_prompt (p);
X        if (read_line (buf, PW-sizeof(p)) <= 0)
X            break;
X        bp = buf;
X        }
X        f_dec_sexsign (-raddeg(lng), °hrs, &mins, &secs);
X        f_sscansex (bp, °hrs, &mins, &secs);
X        sex_dec (deghrs, mins, secs, &lng);
X        lng = degrad (-lng);         /* want - radians west */
X        new = 1;
X        break;
X    case rcfpack (R_LAT, C_LATV, 0):
X        if (!bp) {
X        static char p[] = "latitude (+ north) (d:m:s): ";
X        f_prompt (p);
X        if (read_line (buf, PW-sizeof(p)) <= 0)
X            break;
X        bp = buf;
X        }
X        f_dec_sexsign (raddeg(lat), °hrs, &mins, &secs);
X        f_sscansex (bp, °hrs, &mins, &secs);
X        sex_dec (deghrs, mins, secs, &lat);
X        lat = degrad (lat);
X        new = 1;
X        break;
X    case rcfpack (R_HEIGHT, C_HEIGHTV, 0):
X        if (!bp) {
X        static char p[] = "height above sea level (ft): ";
X        f_prompt (p);
X        if (read_line (buf, PW-sizeof(p)) <= 0)
X            break;
X        bp = buf;
X        }
X        sscanf (bp, "%lf", &height);
X        height /= 2.093e7; /* convert ft to earth radii above sea level */
X        new = 1;
X        break;
X    case rcfpack (R_NSTEP, C_NSTEPV, 0):
X        if (!bp) {
X        static char p[] = "number of steps to run: ";
X        f_prompt (p);
X        if (read_line (buf, 8) <= 0)
X            break;
X        bp = buf;
X        }
X        sscanf (bp, "%d", &nstep);
X        print_nstep (0);
X        break;
X    case rcfpack (R_TEMP, C_TEMPV, 0):
X        if (!bp) {
X        static char p[] = "temperature (deg.F): ";
X        f_prompt (p);
X        if (read_line (buf, PW-sizeof(p)) <= 0)
X            break;
X        bp = buf;
X        }
X        sscanf (bp, "%lf", &temp);
X        temp = 5./9.*(temp - 32.0);    /* want degs C */
X        new = 1;
X        break;
X    case rcfpack (R_PRES, C_PRESV, 0):
X        if (!bp) {
X        static char p[] =
X            "atmos pressure (in. Hg; 0 for no refraction correction): ";
X        f_prompt (p);
X        if (read_line (buf, PW-sizeof(p)) <= 0)
X            break;
X        bp = buf;
X        }
X        sscanf (bp, "%lf", &pressure);
X        pressure *= 33.86;        /* want mBar */
X        new = 1;
X        break;
X    case rcfpack (R_EPOCH, C_EPOCHV, 0):
X        if (!bp) {
X        static char p[] = "epoch (year, or e for Equinox of Date): ";
X        f_prompt (p);
X        if (read_line (buf, PW-strlen(p)) <= 0)
X            break;
X        bp = buf;
X        }
X        if (bp[0] == 'e' || bp[0] == 'E')
X        epoch = EOD;
X        else {
X        double e;
X        e = atof(bp);
X        year_mjd (e, &epoch);
X        }
X        new = 1;
X        break;
X    case rcfpack (R_STPSZ, C_STPSZV, 0):
X        if (!bp) {
X        static char p[] =
X            "step size increment (h:m:s, or <x>d for x days, or r for RTC): ";
X        f_prompt (p);
X        if (read_line (buf, PW-sizeof(p)) <= 0)
X            break;
X        bp = buf;
X        }
X        if (bp[0] == 'r' || bp[0] == 'R')
X        tminc = RTC;
X        else {
X        int last = strlen (bp) - 1;
X        if (bp[last] == 'd') {
X            /* ends in d so treat as a number of days */
X            double x;
X            sscanf (bp, "%lf", &x);
X            tminc = x * 24.0;
X        } else {
X            if (tminc == RTC)
X            deghrs = mins = secs = 0;
X            else
X            f_dec_sexsign (tminc, °hrs, &mins, &secs);
X            f_sscansex (bp, °hrs, &mins, &secs);
X            sex_dec (deghrs, mins, secs, &tminc);
X        }
X        }
X        print_tminc(0);
X        set_t0 (&now);
X        break;
X    case rcfpack (R_PLOT, C_PLOT, 0):
X        plot_setup();
X        if (plot_ison())
X        new = 1;
X        break;
X    case rcfpack (R_WATCH, C_WATCH, 0):
X        watch (&now, tminc, oppl);
X        /* set new reference time to what watch left it.
X         * no need to set new since watch just did a redraw.
X         */
X        set_t0 (&now);
X        break;
X    case rcfpack (R_DAWN, C_DAWN, 0):
X    case rcfpack (R_DUSK, C_DUSK, 0):
X    case rcfpack (R_LON, C_LON, 0):
X        if (optwi ^= 1) {
X        print_updating();
X        mm_twilight (&now, 1);
X        } else {
X        f_blanks (R_DAWN, C_DAWNV, 5);
X        f_blanks (R_DUSK, C_DUSKV, 5);
X        f_blanks (R_LON, C_LONV, 5);
X        }
X        break;
X    case rcfpack (R_SRCH, C_SRCH, 0):
X        srch_setup();
X        if (srch_ison())
X        new = 1;
X        break;
X    case rcfpack (R_SUN, C_OBJ, 0):
X        if ((oppl ^= (1<<SUN)) & (1<<SUN)) {
X        print_updating();
X        alt_body (SUN, 1, &now);
X        } else
X        alt_nobody (SUN);
X        break;
X    case rcfpack (R_MOON, C_OBJ, 0):
X        if ((oppl ^= (1<<MOON)) & (1<<MOON)) {
X        print_updating();
X        alt_body (MOON, 1, &now);
X        } else
X        alt_nobody (MOON);
X        break;
X    case rcfpack (R_MERCURY, C_OBJ, 0):
X        if ((oppl ^= (1<<MERCURY)) & (1<<MERCURY)) {
X        print_updating();
X        alt_body (MERCURY, 1, &now);
X        } else
X        alt_nobody (MERCURY);
X        break;
X    case rcfpack (R_VENUS, C_OBJ, 0):
X        if ((oppl ^= (1<<VENUS)) & (1<<VENUS)) {
X        print_updating();
X        alt_body (VENUS, 1, &now);
X        } else
X        alt_nobody (VENUS);
X        break;
X    case rcfpack (R_MARS, C_OBJ, 0):
X        if ((oppl ^= (1<<MARS)) & (1<<MARS)) {
X        print_updating();
X        alt_body (MARS, 1, &now);
X        } else
X        alt_nobody (MARS);
X        break;
X    case rcfpack (R_JUPITER, C_OBJ, 0):
X        if ((oppl ^= (1<<JUPITER)) & (1<<JUPITER)) {
X        print_updating();
X        alt_body (JUPITER, 1, &now);
X        } else
X        alt_nobody (JUPITER);
X        break;
X    case rcfpack (R_SATURN, C_OBJ, 0):
X        if ((oppl ^= (1<<SATURN)) & (1<<SATURN)) {
X        print_updating();
X        alt_body (SATURN, 1, &now);
X        } else
X        alt_nobody (SATURN);
X        break;
X    case rcfpack (R_URANUS, C_OBJ, 0):
X        if ((oppl ^= (1<<URANUS)) & (1<<URANUS)) {
X        print_updating();
X        alt_body (URANUS, 1, &now);
X        } else
X        alt_nobody (URANUS);
X        break;
X    case rcfpack (R_NEPTUNE, C_OBJ, 0):
X        if ((oppl ^= (1<<NEPTUNE)) & (1<<NEPTUNE)) {
X        print_updating();
X        alt_body (NEPTUNE, 1, &now);
X        } else
X        alt_nobody (NEPTUNE);
X        break;
X    case rcfpack (R_PLUTO, C_OBJ, 0):
X        if ((oppl ^= (1<<PLUTO)) & (1<<PLUTO)) {
X        print_updating();
X        alt_body (PLUTO, 1, &now);
X        } else
X        alt_nobody (PLUTO);
X        break;
X    case rcfpack (R_OBJX, C_OBJ, 0):
X        /* this might change which columns are used so erase all when
X         * returns and redraw if still on.
X         */
X        objx_setup ();
X        alt_nobody (OBJX);
X        if (objx_ison()) {
X        oppl |= 1 << OBJX;
X        print_updating();
X        alt_body (OBJX, 1, &now);
X        } else
X        oppl &= ~(1 << OBJX);    /* already erased; just clear flag */
X        break;
X    }
X
X    return (new);
X}
X
Xstatic
Xprint_tminc(force)
Xint force;
X{
X    static double last;
X
X    if (force || tminc != last) {
X        if (tminc == RTC)
X        f_string (R_STPSZ, C_STPSZV, " RT CLOCK");
X        else if (fabs(tminc) >= 24.0)
X        f_double (R_STPSZ, C_STPSZV, "%6.4g dy", tminc/24.0);
X        else
X        f_signtime (R_STPSZ, C_STPSZV, tminc);
X        last = tminc;
X    }
X}
X
Xstatic
Xprint_bodies (force)
Xint force;
X{
X    int p;
X
X    for (p = nxtbody(-1); p != -1; p = nxtbody(p))
X        if (oppl & (1<<p))
X        alt_body (p, force, &now);
X}
X
Xstatic
Xclrall_bodies ()
X{
X    int p;
X
X    for (p = nxtbody(-1); p != -1; p = nxtbody(p))
X        if (oppl & (1<<p))
X        alt_nobody (p);
X}
X
Xprint_updating()
X{
X    f_prompt ("Updating...");
X}
X
Xstatic
Xprint_nstep(force)
Xint force;
X{
X    static int last;
X
X    if (force || nstep != last) {
X        char buf[16];
X        sprintf (buf, "%8d", nstep);
X        f_string (R_NSTEP, C_NSTEPV, buf);
X        last = nstep;
X    }
X}
EOFxEOF
len=`wc -c < main.c`
if expr $len != 21224 > /dev/null
then echo Length of main.c is $len but it should be 21224.
fi